;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021, 2023 Joshua Branson <jbranso@dismail.de>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;; TODO  use this link to try to get https://issues.guix.gnu.org/60788
;;; this service looking more like that service.
;;; I can play with that service via
;;; https://paste.centos.org/view/252474c7
;;;
;;;
;;; /gnu/store/a61fxpb2g7fgcr3zmcq891qlwqjinyvn-run-vm.sh
;;;
;;; newer vm:
;;; /gnu/store/07g2mklr9fr3xhwcw8n917cbzpm0dzr9-run-vm.sh
;;;
;;; even never vm:
;;; /gnu/store/4iw889ffc43xay3g4qg7ccv5l8yr5zk9-run-vm.sh
;;;
;;; even even newer vm:
;;; /gnu/store/yx4dbwqxn3ykf2clwl85mzgkzpr1c7xp-run-vm.sh
;;;

(define-module (endlessh-service)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix build-system trivial)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages ssh)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services dbus)
  #:use-module (gnu services admin)
  #:use-module (gnu system shadow)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (
            endlessh-configuration
            endlessh-configuration?
            endlessh-configuration-bind-family
            endlessh-configuration-delay
            endlessh-configuration-length
            endlessh-configuration-log-level
            endlessh-configuration-max-clients
            endlessh-configuration-package
            endlessh-configuration-port
            endlessh-service-type
            %default-endlessh
            ))

;;;; Commentary:
;;; This file provides a basic server to run endlessh.
;;; https://github.com/skeeto/endlessh
;;;; Code:

(define (camelfy-field-name field-name)
  (match (string-split (symbol->string field-name) #\-)
    ((head tail ...)
     (string-join (cons (string-upcase head 0 1)
                        (map (cut string-upcase <> 0 1) tail)) ""))))



(define (serialize-integer field-name val)
  (string-append (camelfy-field-name field-name) " "
                 (number->string val) "\n"))

(define (list-of-bind-family? val)
  (or (equal? val '(ipv4 ipv6))
      (equal? val '(ipv6 ipv4))
      (equal? val '(ipv4))
      (equal? val '(ipv6))))

(define (serialize-list-of-bind-family field-name val)
  (string-append
   (camelfy-field-name field-name) " "
   (cond ((or (equal? val '(ipv4 ipv6))
              (equal? val '(ipv6 ipv4)))
          "0")
         ((equal? val '(ipv4))
          "4")
         (else "6")))
  "\n")

(define-configuration endlessh-configuration
  (package
   (package endlessh)
   "The endlessh package to use.")
  (bind-family
   (list-of-bind-family '(ipv4 ipv6))
   "A list of symbols of ip families to run endlessh: ipv4 and/or ipv6.")
  (delay
    (integer 10000)
    "Message milliseconds delay. Default: 10000")
  (max-line-length
   (integer 32)
   "Maximum banner line length (3-255). Default: 32")
  (max-clients
   (integer 4096)
   "Maximum number of clients. Default: 4096")
  (port
   (integer 2222)
   "Set the listening port. Default: 2222")
  (log-level
   (integer 0)
   "Print diagnostics.  Allowed values are 0, 1, 2.  The higher the value
the more detailed the log.  A value of 0 turns off logging."))

(define (serialize-endlessh-configuration config)
  (mixed-text-file
   "endlessh.conf"
   (serialize-configuration config endlessh-configuration-fields)))

(define (generate-endlessh-documentation)
  (generate-documentation
   `((endlessh-configuration
      ,endlessh-configuration-fields))
   'endlessh-configuration))

;; how can I add shepherd-configuration-file? to return the service's
;; current config file?
(define (endlessh-shepherd-service config)
  (list (shepherd-service
         (provision '(endlessh))
         (documentation "Run the endlessh daemon.")
         ;; change this to user-processes & networking? like nginx?
         (requirement '(networking))
         (start #~(make-forkexec-constructor
                   (list #$(file-append (endlessh-configuration-package config)
                                        "/bin/endlessh")
                         "-f" #$(serialize-endlessh-configuration config))
                   #:user "endlessh"
                   #:group "endlessh"))
         (stop #~(make-kill-destructor)))))

(define %endlessh-accounts
  (list (user-group (name "endlessh")
                    (system? #t))
        (user-account
         (name "endlessh")
         (group "endlessh")
         (system? #t)
         (comment "endlessh user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

;; (define endlessh-activation
;;   (match-lambda
;;     (($ <endlessh-configuration> package config-file)
;;      (with-imported-modules '((guix build utils))
;;        #~(begin
;;            (use-modules (guix build utils))
;;            (let ([x #t])
;;              x))))))

(define endlessh-service-type
  (service-type
   (name 'endlessh)
   (description "Run endlessh, a small turning ssh tarpit.")
   (extensions
    (list (service-extension shepherd-root-service-type endlessh-shepherd-service)
          (service-extension account-service-type
                             (const %endlessh-accounts))
          ;;(service-extension activation-service-type endlessh-activation)
          ))
   (default-value (endlessh-configuration))))
